Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/ISSUE11/AUTOSAVE/AUTOSAVE.ZIP/autosave.pas

Pascal/Delphi Source File | 1996-06-08 | 17.1 KB | 483 lines

{+------------------------------------------------------------
 | Library AutoSave
 |
 | Version: 1.0  Created: 06/07/96, 12:26:09
 |               Last Modified: 06/07/96, 12:26:09
 | Author : P. Below
 | Project: Autosave expert for Delphi 1.0
 | Description:
 |   Autosave expert for Delphi. Provides automatic saving of
 |   files on loss of focus and reload on gain of focus.
 |   This is a DLL expert, install it by inserting a line
 |   like the following (path adjusted, of course) into your
 |   Delphi.INI, in the [Experts] section:
 |
 |   autosave=f:\delphi\projects\experts\autosave.dll
 |
 |   You will find a new menu item under the Help menu that will
 |   read "Disable Autosave" or "Enable Autosave", depending on
 |   the state of the expert. The expert is enabled at startup.
 |
 | I noticed some timing problems with this expert using Delphi
 | 1.0 and CodeWright 32 on Windows NT 3.51. The "save files on
 | loss of focus" option in CW32 actually does the save as a
 | background thread so Delphi will be active before the save
 | has been completed and as a consequence the files date/time
 | stamp has not yet changed! Consequence: failure to reload
 | the file in Delphi. The switch backwards can have similar
 | problems, probably because of NTs lazy buffering scheme on
 | disk writes. Switching buffers in CW will cause the reload
 | to occur. Manually saving the file in CW before switching
 | to Delphi takes care of the first problem.
 | Not a very satisfactory situation but as a temporary measure
 | the options to save or restore all open files is provided
 | in two additional exports.
 +------------------------------------------------------------}
Library AutoSave;

Uses Messages, Wintypes, WinProcs, SysUtils, ToolIntf, ExptIntf;

Type
  TAutoSaveExpert = class(TIExpert)
  private
    FIsActive: Boolean;             { state flag }
    FToolServices: TIToolServices;  { Delphi service requester }
    Procedure SetIsActive( state: Boolean );
  public
    { Expert UI strings }
    Constructor Create( TS: TIToolServices );
    function GetName: string; override;
    function GetComment: string; override;
    function GetGlyph: HBITMAP; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;

    { Launch the Expert }
    procedure Execute; override;

    { Procedures called on loss and gain of focus }
    Procedure SaveAllFiles;
    Procedure RestoreAllFiles;

    property IsActive: Boolean read FIsActive write SetIsActive;
  end;

  TSaveAllExpert = class(TIExpert)
  public
    { Expert UI strings }
    function GetName: string; override;
    function GetComment: string; override;
    function GetGlyph: HBITMAP; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;

    { Launch the Expert }
    procedure Execute; override;
  end;

  TRestoreAllExpert = class(TIExpert)
  public
    { Expert UI strings }
    function GetName: string; override;
    function GetComment: string; override;
    function GetGlyph: HBITMAP; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;

    { Launch the Expert }
    procedure Execute; override;
  end;

Var
  TheExpert: TAutoSaveExpert;
  SAExpert : TSaveAllExpert;
  RAExpert : TRestoreAllExpert;
  OldWndProc: TFarProc;
  hDelphi: HWND;


{+-----------------------------------------------------------------------
 | The expert subclasses the Delphi application window and waits for
 | WM_ACTIVATEAPP messages to arrive. Depending on the wparam of this
 | message it will call the SaveAllFiles or RestoreAllFiles methods of
 | the expert. The expert calls two service procedures, HookDelphi and
 | UnhookDelphi, if its state changes from inactive to active and back.
 | These tow procedures use API functions to find the Delphi application
 | window and subclass it.
 +----------------------------------------------------------------------}

{+-EnumProc-----------------------------------------------------------
 | This function is a callback used with EnumTaskWindows to find the
 | Delphi application window. It just checks the class name of the
 | passed window. If that is TApplication the window handle is returned
 | and enumeration stops.
 +-------------------------------------------------------------------}
 Function EnumProc( aWnd: HWnd; Var foundHwnd: HWND ): Bool; export;
  Var
    buf: Array [0..40] of Char;
  Begin
    buf[0] := #0;
    GetClassName( aWnd, buf, 41 );
    buf[40]:= #0;
    Result := StrIComp(buf, 'TApplication') <> 0;
    If not Result Then
      foundHWnd := aWnd;
  End; { EnumProc }

{+-FindDelphiApp--------------------------------------------------------
 | This function is called by HookDelphi to find the Delphi application
 | window. It returns the handle of this window, or 0, if the window
 | could not be found (highly unlikely).
 +---------------------------------------------------------------------}
 Function FindDelphiApp: HWND;
  Begin
    Result := 0;
    EnumTaskWindows( GetCurrentTask, @EnumProc, LongInt(@Result));
  End; { FindDelphiApp }

{+-UnHookDelphi----------------------------------------------------------
 | This procedure undoes the subclassing for the Delphi application
 | window. It is called either when the state of the expert changes to
 | inactive or when Delphi is going down and the replacement window proc
 | sees a WM_DESTROY.
 +----------------------------------------------------------------------}
 Procedure UnHookDelphi;
  Begin
    If hDelphi <> 0 Then Begin
      SetWindowLong( hDelphi, GWL_WNDPROC, LongInt(OldWndProc));
      OldWndProc := Nil;
      hDelphi := 0;
    End; { If }
  End; { UnHookDelphi }

{+-WndProc--------------------------------------------------------------
 | This is the replacement window procedure used for the Delphi
 | application window. It passes all messages to the original window
 | proc. WM_ACTIVATEAPP and WM_DESTROY are acted upon.
 | The function will see WM_ACTIVATEAPP with wparam = 0 if Delphi is
 | loosing the focus. We save all files in this case. If wparam is <> 0
 | Delphi is gaining the focus and we restore all files. As an
 | additional safeguard the function will undo the subclassing on
 | WM_DESTROY. That should have happend before this message arrives,
 | however (see FinshExpert).
 +---------------------------------------------------------------------}
 Function WndProc(aWnd: HWND; aMsg, wparam: Word; lparam: LongInt):
  LongInt; export;
  Begin
    If aMsg = WM_ACTIVATEAPP Then Begin
      If wparam = 0 Then
        TheExpert.SaveAllFiles
      Else
        TheExpert.RestoreAllFiles;
    End { If }
    Else
      If aMsg = WM_DESTROY Then Begin
        { Call old winproc first because UnHookdelphi will set OldWndProc
          to Nil! }
        Result := CallWindowProc( OldWndProc, aWnd, aMsg, wparam, lparam );
        UnHookDelphi;
        Exit;
      End; { If }
    Result := CallWindowProc( OldWndProc, aWnd, aMsg, wparam, lparam );
  End; { WndProc }

{+-HookDelphi--------------------------------------------------------
 | This procedure does the subclassing for the Delphi application
 | window. It is called when the state of the expert changes to
 | active.
 +-------------------------------------------------------------------}
Procedure HookDelphi;
  Begin
    hDelphi := FindDelphiApp;
    If hDelphi <> 0 Then Begin
      OldWndProc := Pointer(
        SetWindowLong( hDelphi, GWL_WNDPROC, LongInt(@WndProc)))
    End; { If }
  End; { HookDelphi }

{+----------------------------
 | Methods of TAutoSaveExpert
 +---------------------------}

{+-Create-------------------------------------------------------------
 | Create the expert, save the passed reference to the Delphi service
 | provider, activate the expert, which causes the subclassing to be
 | performed.
 +-------------------------------------------------------------------}
 Constructor TAutoSaveExpert.Create( TS: TIToolServices );
  Begin
    inherited Create;
    FToolServices := TS;
    isActive := True;
  End; { TAutoSaveExpert.Create }

{ The following are the standard methods required of an expert. }
function TAutoSaveExpert.GetName: string;
  Begin
    Result := 'AutoSave Expert';
  End; { TAutoSaveExpert.GetName }

function TAutoSaveExpert.GetComment: string;
  Begin
    Result := EmptyStr;
  End; { TAutoSaveExpert.GetComment }

function TAutoSaveExpert.GetGlyph: HBITMAP;
  Begin
    Result := 0;
  End; { TAutoSaveExpert.GetGlyph }

function TAutoSaveExpert.GetStyle: TExpertStyle;
  Begin
    Result := esStandard;
  End; { TAutoSaveExpert.GetStyle }

function TAutoSaveExpert.GetState: TExpertState;
  Begin
    Result := [esEnabled];
  End; { TAutoSaveExpert.GetState }

function TAutoSaveExpert.GetIDString: string;
  Begin
    Result := 'PBelow.AutoSaveExpert';
  End; { TAutoSaveExpert.GetIDString }

function TAutoSaveExpert.GetMenuText: string;
  Begin
    If IsActive Then
      Result := 'Disable AutoSave'
    Else
      Result := 'Enable AutoSave';
  End; { TAutoSaveExpert.GetMenuText }

{+-Execute------------------------------------------------------------
 | This method is called if the user selects the menu item for the
 | expert. This switches the state of the expert and causes a message
 | to appear.
 +-------------------------------------------------------------------}
procedure TAutoSaveExpert.Execute;
  Const
    Messages: Array [Boolean] of Pchar =
      ('Autosave expert has been deactivated.',
       'Autosave expert has been activated.');
  Begin
    IsActive := not IsActive;
    MessageBox( GetActiveWindow, Messages[IsActive], 'AutoSave',
                MB_OK or MB_ICONINFORMATION );
  End; { TAutoSaveExpert.Execute }

{+-SetIsActive--------------------------------------------------------
 | This method is called when the state of the expert is changed. It
 | performs the appropriate subclassing or unsubclassing and sets the
 | FIsActive flag to the new state.
 +-------------------------------------------------------------------}
Procedure TAutoSaveExpert.SetIsActive( state: Boolean );
  Begin
    If state <> FIsActive Then Begin
      If FIsActive Then
        UnhookDelphi
      Else
        HookDelphi;
      FIsActive := (hDelphi <> 0);
    End; { If }
  End; { TAutoSaveExpert.SetIsActive }

{+-SaveAllFiles----------------------------------------------------------
 | This method is called from the replacement window proc on loss of
 | focus. It saves the project and all open units that belong to the
 | project. I'm not sure if this loop also saves open files that do not
 | belong to the project!
 +----------------------------------------------------------------------}
Procedure TAutoSaveExpert.SaveAllFiles;
  Var
    i: Integer;
    S: String;
  Begin
    With FToolServices Do
      If Length(GetprojectName) > 0 Then Begin
        SaveProject;
        For i := 0 To GetUnitCount-1 Do Begin
          S := GetUnitName(i);
          If IsFileOpen(S) Then
            SaveFile( S );
        End; { For }
      End; { If }
  End; { TAutoSaveExpert.SaveAllFiles }

{+-RestoreAllFiles----------------------------------------------------
 | This method is called from the replacement window proc on gain of
 | focus. It restores all open units that belong to the project.
 | I'm not sure if this loop also restores open files that do not
 | belong to the project!
 +----------------------------------------------------------------------}
Procedure TAutoSaveExpert.RestoreAllFiles;
  Var
    i: Integer;
    S: String;
  Begin
    With FToolServices Do Begin
      If Length(GetprojectName) > 0 Then
        For i := 0 To GetUnitCount-1 Do Begin
          S := GetUnitName(i);
          If IsFileOpen(S) Then
            ReloadFile( S );
        End; { For }
    End; { With }
  End; { TAutoSaveExpert.RestoreAllFiles }

{+----------------------------
 | Methods of TSaveAllExpert
 +---------------------------}

{ The following are the standard methods required of an expert. }
function TSaveAllExpert.GetName: string;
  Begin
    Result := 'SaveAll Expert';
  End; { TSaveAllExpert.GetName }

function TSaveAllExpert.GetComment: string;
  Begin
    Result := EmptyStr;
  End; { TSaveAllExpert.GetComment }

function TSaveAllExpert.GetGlyph: HBITMAP;
  Begin
    Result := 0;
  End; { TSaveAllExpert.GetGlyph }

function TSaveAllExpert.GetStyle: TExpertStyle;
  Begin
    Result := esStandard;
  End; { TSaveAllExpert.GetStyle }

function TSaveAllExpert.GetState: TExpertState;
  Begin
    Result := [esEnabled];
  End; { TSaveAllExpert.GetState }

function TSaveAllExpert.GetIDString: string;
  Begin
    Result := 'PBelow.SaveAllExpert';
  End; { TSaveAllExpert.GetIDString }

function TSaveAllExpert.GetMenuText: string;
  Begin
    Result := 'Save all files';
  End; { TSaveAllExpert.GetMenuText }

{+-Execute------------------------------------------------------------
 | This method is called if the user selects the menu item for the
 | expert.
 +-------------------------------------------------------------------}
procedure TSaveAllExpert.Execute;
  Begin
    TheExpert.SaveAllFiles
  End; { TSaveAllExpert.Execute }

{+----------------------------
 | Methods of TRestoreAllExpert
 +---------------------------}

{ The following are the standard methods required of an expert. }
function TRestoreAllExpert.GetName: string;
  Begin
    Result := 'RestoreAll Expert';
  End; { TRestoreAllExpert.GetName }

function TRestoreAllExpert.GetComment: string;
  Begin
    Result := EmptyStr;
  End; { TRestoreAllExpert.GetComment }

function TRestoreAllExpert.GetGlyph: HBITMAP;
  Begin
    Result := 0;
  End; { TRestoreAllExpert.GetGlyph }

function TRestoreAllExpert.GetStyle: TExpertStyle;
  Begin
    Result := esStandard;
  End; { TRestoreAllExpert.GetStyle }

function TRestoreAllExpert.GetState: TExpertState;
  Begin
    Result := [esEnabled];
  End; { TRestoreAllExpert.GetState }

function TRestoreAllExpert.GetIDString: string;
  Begin
    Result := 'PBelow.RestoreAllExpert';
  End; { TRestoreAllExpert.GetIDString }

function TRestoreAllExpert.GetMenuText: string;
  Begin
    Result := 'Reload all files';
  End; { TRestoreAllExpert.GetMenuText }

{+-Execute------------------------------------------------------------
 | This method is called if the user selects the menu item for the
 | expert.
 +-------------------------------------------------------------------}
procedure TRestoreAllExpert.Execute;
  Begin
    TheExpert.RestoreAllFiles
  End; { TRestoreAllExpert.Execute }


{+-FinishExpert------------------------------------------------------
 | This procedure is a callback called by Delphi when the DLL is about
 | to be unloaded. It undoes the subclassing and destroys the expert.
 +--------------------------------------------------------------------}
Procedure FinishExpert; export;
  Begin
    If Assigned(TheExpert) Then
      With TheExpert Do Begin
        IsActive := False;
        Free;
        TheExpert := Nil;
      End; { With }
    SAExpert.Free;
    RAExpert.Free;
  End;


{+-InitExpert-----------------------------------------------------------
 | This is the entry point for the DLL. It is called by Delphi when the
 | DLL is loaded. We create the expert object here, store the passed
 | registerproc and tell Delphi which procedure to call on termination.
 +---------------------------------------------------------------------}
Function InitExpert(ToolServices: TIToolServices;
    RegisterProc: TExpertRegisterProc;
    var Terminate: TExpertTerminateProc): Boolean; export;
  Begin
    LibraryExpertProc := RegisterProc;
    Terminate := FinishExpert;
    TheExpert := TAutoSaveExpert.Create(ToolServices);
    RegisterLibraryExpert( TheExpert );
    SAExpert := TSaveAllExpert.Create;
    RegisterLibraryExpert( SAExpert );
    RAExpert := TRestoreAllExpert.Create;
    RegisterLibraryExpert( RAExpert );

    Result := True;
  End; { InitExpert }


exports
  InitExpert name ExpertEntryPoint;

Begin
  TheExpert:= Nil;;
  SAExpert := Nil;
  RAExpert := Nil;
  OldWndProc:= Nil;
  hDelphi:= 0;
End. { Library AutoSave }